home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / WINPASCL / DRYSTONE.PAS < prev    next >
Pascal/Delphi Source File  |  1990-09-28  |  8KB  |  319 lines
  1. PROGRAM Dhrystone( input, output );
  2. (*
  3.  *   "DHRYSTONE" Benchmark Program
  4.  *
  5.  *   Version:   Mod2/1
  6.  *   Date:      05/03/86
  7.  *   Author:      Reinhold P. Weicker,  CACM Vol 27, No 10, 10/84 pg. 1013
  8.  *         C version translated from ADA by Rick Richardson
  9.  *         Every method to preserve ADA-likeness has been used,
  10.  *         at the expense of C-ness.
  11.  *         Modula-2 version translated from C by Kevin Northover.
  12.  *         Again every attempt made to avoid distortions of the original.
  13.  *   Machine Specifics:
  14.  *         The LOOPS constant is initially set for 50000 loops.
  15.  *         If you have a machine with large integers and is
  16.  *         very fast, please change this number to 500000 to
  17.  *         get better accuracy.
  18.  *
  19.  **************************************************************************
  20.  *
  21.  *   The following program contains statements of a high-level programming
  22.  *   language (Modula-2) in a distribution considered representative:
  23.  *
  24.  *   assignments         53%
  25.  *   control statements      32%
  26.  *   procedure, function calls   15%
  27.  *
  28.  *   100 statements are dynamically executed.  The program is balanced with
  29.  *   respect to the three aspects:
  30.  *      - statement type
  31.  *      - operand type (for simple data types)
  32.  *      - operand access
  33.  *         operand global, local, parameter, or constant.
  34.  *
  35.  *   The combination of these three aspects is balanced only approximately.
  36.  *
  37.  *   The program does not compute anything meaningfull, but it is
  38.  *   syntactically and semantically correct.
  39.  *
  40.  *)
  41.  
  42. (*$R- range checking off*)
  43.  
  44.  
  45. CONST     
  46.  
  47. (*    Set LOOPS to specify how many thousand drystones to perform.
  48.       LOOPS = 50 will perforum 50,000 drystones. Choose longer for
  49.       better precision and for fast machines.
  50. *)
  51.  
  52.   LOOPS =  10;      (* Use this for slow or 16 bit machines *)
  53.   Ident1 = 1;
  54.   Ident2 = 2;
  55.   Ident3 = 3;
  56.   Ident4 = 4;
  57.   Ident5 = 5;
  58.  
  59. Type Enumeration = INTEGER;
  60. (* TYPE Enumeration = (Ident1, Ident2, Ident3, Ident4, Ident5); *)
  61.  
  62. TYPE   OneToThirty   = INTEGER;
  63. TYPE   OneToFifty    = INTEGER;
  64. TYPE   CapitalLetter = CHAR;
  65. TYPE   String30      = ARRAY[0..30] OF CHAR;
  66. TYPE   Array1Dim     = ARRAY[0..50] OF INTEGER;
  67. TYPE   Array2Dim     = ARRAY[0..50,0..50] OF INTEGER;
  68.  
  69. (* TYPE   RecordPtr     = ^RecordType; *)
  70.        RecordType    = RECORD
  71.                          PtrComp    : integer;
  72.                          Discr      : Enumeration;
  73.                          EnumComp   : Enumeration;
  74.                          IntComp    : OneToFifty;
  75.                          StringComp : String30;
  76.                        END;
  77.  
  78. (*
  79.  * Package 1
  80.  *)
  81. VAR
  82.   IntGlob    : INTEGER;
  83.   BoolGlob   : BOOLEAN;
  84.   Char1Glob  : CHAR;
  85.   Char2Glob  : CHAR ;
  86.   Array1Glob : Array1Dim;
  87.   Array2Glob : Array2Dim;
  88.   MyRec      : array[0..2] of RecordType;
  89. (*  PtrGlb     : RecordPtr; *)
  90. (*  PtrGlbNext : RecordPtr; *)
  91.  
  92.   Hour, Min, Sec, Hund : Integer;
  93.   TStart, TEnd : real;
  94.  
  95. CONST
  96.   PtrGlb     = 1;
  97.   PtrGlbNext = 2;
  98.  
  99. PROCEDURE Proc7(IntParI1, IntParI2 : OneToFifty; VAR IntParOut : OneToFifty);
  100. VAR
  101.    IntLoc  : OneToFifty;
  102. BEGIN
  103.    IntLoc:= IntParI1 + 2;
  104.    IntParOut:= IntParI2 + IntLoc;
  105. END ;
  106.  
  107. PROCEDURE Proc3( var inRecIdx : integer );
  108. BEGIN
  109.    IF ( inRecIdx <> 0 ) THEN
  110.       inRecIdx := MyRec[PtrGlb].PtrComp
  111.    ELSE
  112.       IntGlob:= 100;
  113.    Proc7( 10, IntGlob, MyRec[PtrGlb].IntComp);
  114. END ;
  115.  
  116. FUNCTION Func3(EnumParIn : Enumeration) : BOOLEAN;
  117.   VAR EnumLoc: Enumeration;
  118. BEGIN
  119.    EnumLoc:= EnumParIn;
  120.    Func3:= EnumLoc = Ident3;
  121. END ;
  122.  
  123. PROCEDURE Proc6(EnumParIn : Enumeration; VAR EnumParOut : Enumeration);
  124. BEGIN
  125.    EnumParOut:= EnumParIn;
  126.    IF (NOT Func3(EnumParIn) ) THEN
  127.       EnumParOut:= Ident4;
  128.    CASE EnumParIn OF
  129.     Ident1:   EnumParOut:= Ident1 ;
  130.     Ident2:   IF (IntGlob > 100) THEN EnumParOut:= Ident1
  131.                                  ELSE EnumParOut:= Ident4;
  132.     Ident3:   EnumParOut:= Ident2 ;
  133.     Ident4:   ; 
  134.     Ident5:   EnumParOut:= Ident3;
  135.    END;
  136. END ;
  137.  
  138.  
  139. PROCEDURE Proc1( inIdx : integer );
  140. var
  141.    i : integer;
  142. BEGIN
  143.    i := MyRec[inIdx].PtrComp;
  144.  
  145.    MyRec[i] := MyRec[PtrGlb];
  146.    MyRec[inIdx].IntComp := 5;
  147.    MyRec[i].IntComp:= MyRec[inIdx].IntComp;
  148.    MyRec[i].PtrComp:= i;
  149.    Proc3( MyRec[i].PtrComp );
  150.    IF ( MyRec[i].Discr = Ident1 ) THEN
  151.       BEGIN 
  152.          MyRec[i].IntComp:= 6;
  153.          Proc6( MyRec[inIdx].EnumComp, MyRec[i].EnumComp );
  154.          MyRec[i].PtrComp:= MyRec[PtrGlb].PtrComp;
  155.          Proc7( MyRec[i].IntComp, 10, MyRec[i].IntComp );
  156.       END
  157.    ELSE
  158.       MyRec[inIdx] := MyRec[i];
  159. END;
  160.  
  161.  
  162. PROCEDURE Proc2(VAR IntParIO : OneToFifty);
  163. VAR
  164.    IntLoc  : OneToFifty;
  165.    EnumLoc : Enumeration;
  166. BEGIN
  167.    IntLoc:= IntParIO + 10;
  168.    REPEAT
  169.      IF (Char1Glob = 'A') THEN
  170.       BEGIN
  171.          IntLoc:= IntLoc - 1;
  172.          IntParIO:= IntLoc - IntGlob;
  173.          EnumLoc:= Ident1;
  174.       END;
  175.    UNTIL EnumLoc = Ident1;
  176. END ;
  177.  
  178. PROCEDURE Proc4;
  179. VAR
  180.    BoolLoc : BOOLEAN;
  181. BEGIN
  182.    BoolLoc:= Char1Glob = 'A';
  183.    BoolLoc:= BoolLoc OR BoolGlob;
  184.    Char2Glob:= 'B';
  185. END ;
  186.  
  187. PROCEDURE Proc5;
  188. BEGIN
  189.    Char1Glob:= 'A';
  190.    BoolGlob:= FALSE;
  191. END ;
  192.  
  193. PROCEDURE Proc8(VAR Array1Par : Array1Dim; VAR Array2Par : Array2Dim;
  194.       IntParI1, IntParI2 : OneToFifty);
  195. VAR
  196.    IntLoc   : OneToFifty;
  197.    IntIndex : OneToFifty;
  198. BEGIN
  199.    IntLoc:= IntParI1 + 5;
  200.    Array1Par[IntLoc]:= IntParI2;
  201.    Array1Par[IntLoc+1]:= Array1Par[IntLoc];
  202.    Array1Par[IntLoc+30]:= IntLoc;
  203.    FOR IntIndex:= IntLoc TO (IntLoc+1) DO
  204.       Array2Par[IntLoc][IntIndex]:= IntLoc; 
  205.    Array2Par[IntLoc][IntLoc-1]:= Array2Par[IntLoc][IntLoc-1] + 1;
  206.    Array2Par[IntLoc+20][IntLoc]:= Array1Par[IntLoc];
  207.    IntGlob:= 5;
  208. END ;
  209.  
  210. FUNCTION Func1(CharPar1, CharPar2 : CapitalLetter) : Enumeration;
  211. VAR
  212.    CharLoc1, CharLoc2 : CapitalLetter;
  213. BEGIN
  214.    CharLoc1:= CharPar1;
  215.    CharLoc2:= CharLoc1;
  216.    IF (CharLoc2 <> CharPar2) THEN
  217.       Func1:= (Ident1)
  218.    ELSE
  219.       Func1:= (Ident2);
  220. END ;
  221.  
  222. FUNCTION Func2(VAR StrParI1, StrParI2 : String30) : BOOLEAN;
  223. VAR
  224.    IntLoc   : OneToThirty;
  225.    CharLoc  : CapitalLetter;
  226. BEGIN
  227.    IntLoc := 2;
  228.    WHILE (IntLoc <= 2) DO
  229.     BEGIN
  230.      IF (Func1(StrParI1[IntLoc], StrParI2[IntLoc+1]) = Ident1) THEN
  231.        BEGIN
  232.          CharLoc := 'A';
  233.          IntLoc:= IntLoc + 1;
  234.        END;
  235.     END;
  236.    IF (CharLoc >= 'W') AND (CharLoc <= 'Z') THEN IntLoc:= 7;
  237.    IF CharLoc = 'X' THEN 
  238.      Func2:= TRUE
  239.    ELSE IF StrParI1 > StrParI2 THEN
  240.     BEGIN
  241.      IntLoc:= IntLoc + 7;
  242.      Func2:= TRUE
  243.     END
  244.    ELSE 
  245.      Func2:= FALSE;
  246. END ;
  247.  
  248.  
  249. PROCEDURE Proc0;
  250. VAR
  251.    IntLoc1    : OneToFifty;
  252.    IntLoc2    : OneToFifty;
  253.    IntLoc3    : OneToFifty;
  254.    CharLoc    : CHAR;
  255.    CharIndex  : CHAR;
  256.    EnumLoc    : Enumeration;
  257.    String1Loc,
  258.    String2Loc : String30;
  259.    i,
  260.    j          : INTEGER;
  261.  
  262. BEGIN
  263. (*
  264.    NEW(PtrGlbNext);
  265.    NEW(PtrGlb);
  266. *)
  267.  
  268.    MyRec[PtrGlb].PtrComp:= PtrGlbNext;
  269.    MyRec[PtrGlb].Discr:= Ident1;
  270.    MyRec[PtrGlb].EnumComp:= Ident3;
  271.    MyRec[PtrGlb].IntComp:= 40;
  272.    MyRec[PtrGlb].StringComp := 'DHRYSTONE PROGRAM, SOME STRING';
  273.  
  274.    String1Loc := 'DHRYSTONE PROGRAM, 1''ST STRING';
  275.  
  276. FOR i := 1 TO LOOPS DO
  277.   FOR j := 1 TO 1000 DO
  278.   BEGIN
  279.    Proc5;
  280.    Proc4;
  281.    IntLoc1:= 2;
  282.    IntLoc2:= 3;
  283.    String2Loc := 'DHRYSTONE PROGRAM, 2''ND STRING';
  284.    EnumLoc:= Ident2;
  285.    BoolGlob:= NOT Func2(String1Loc, String2Loc);
  286.    WHILE (IntLoc1 < IntLoc2) DO
  287.     BEGIN
  288.       IntLoc3 := 5 * IntLoc1 - IntLoc2;
  289.       Proc7(IntLoc1, IntLoc2, IntLoc3);
  290.       IntLoc1:= IntLoc1 + 1;
  291.     END;
  292.    Proc8(Array1Glob, Array2Glob, IntLoc1, IntLoc3);
  293.    Proc1(PtrGlb);
  294.    CharIndex:= 'A';
  295.    WHILE  CharIndex <= Char2Glob DO
  296.      BEGIN
  297.       IF (EnumLoc = Func1(CharIndex, 'C')) THEN
  298.          Proc6(Ident1, EnumLoc);
  299.       CharIndex:= SUCC(CharIndex);
  300.      END;
  301.    IntLoc3:= IntLoc2 * IntLoc1;
  302.    IntLoc2:= IntLoc3 DIV IntLoc1;
  303.    IntLoc2:= 7 * (IntLoc3 - IntLoc2) - IntLoc1;
  304.    Proc2(IntLoc1);
  305.  END;
  306. END;
  307.  
  308. (* The Main Program is trivial *)
  309. BEGIN
  310.    writeln( 'Start of Dhrystone benchmark' );
  311.    GetTime( hour, min, sec, hund );
  312.    TStart := (min * 60) + sec + (hund / 100);
  313.    Proc0;
  314.    GetTime( hour, min, sec, hund );
  315.    TEnd := (min * 60) + sec + (hund / 100);
  316.    writeln( 'End of Dhrystone benchmark ', (TEnd-TStart):6:2, ' seconds.' );
  317. END.
  318.  
  319.